home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / prog / hcn305.arj / GSDMO_18.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-02  |  9KB  |  223 lines
  1. program GSDMO_18;
  2. {-----------------------------------------------------------------------------
  3.                              DBase Error Handler
  4.  
  5.        Copyright (c)  Richard F. Griffin
  6.  
  7.        29 January 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.  
  14.        Demonstrates use of error handling for fatal errors.
  15.  
  16.        The following is an example of inserting a user-supplied error
  17.        handling procedure.  This sample program demonstrates how this
  18.        procedure may be installed in a user's program.  All calls to
  19.        Error anywhere in the file object's heirarchy will come through
  20.        this 'hook'.
  21.  
  22.        The program assigns a user-supplied routine to process run error
  23.        information.   A 'hook' is available to allow the user to gain
  24.        access to the runtime errors generated by Griffin Solutions objects.
  25.        The default procedure DefCapError halts the program using RunError.
  26.        If the user chooses to take advantage of error capture to allow
  27.        graceful recovery or shutdown, it is done by replacing DefCapError
  28.        with his or her own routines via SetErrorCapture.
  29.  
  30.        Note that the assigned procedure must use far calls ($F+).
  31.  
  32.        Griffin Solutions routines call Error for non-recoverable errors.
  33.        The call is:  Error(Code, Info).  Constants passed as arguments
  34.        are contained in the GSOB_VAR unit.  The User supplied program must
  35.        process the error using Code as the run error code.  Info provides
  36.        additional information about the error.
  37.  
  38.        This example routine traps Error Code and Info arguments and then
  39.        translates to text by using an array of error code records.  Several
  40.        errors have been embedded in the program's main code that will
  41.        cause RunTime Errors to occur--can you find them all?
  42.        (answers at the end of the program list)
  43.  
  44. ------------------------------------------------------------------------------}
  45.  
  46. uses
  47.    GSOB_Var,
  48.    GSOBShel,
  49.    GSOB_Gen,
  50.    {$IFDEF WINDOWS}
  51.       WinCRT,
  52.       WinDOS;
  53.    {$ELSE}
  54.       CRT,
  55.       DOS;
  56.    {$ENDIF}
  57.  
  58.  
  59.  
  60. type
  61.    ErrListRec = record
  62.       ErrCode : integer;
  63.       ErrStr  : string[40];
  64.    end;
  65.  
  66. const
  67.    ErrCount = 79;
  68.  
  69.    ErrListAry : array[1..ErrCount] of ErrListRec = (
  70.          (ErrCode: 1; ErrStr: 'Invalid function number'),
  71.          (ErrCode: 2; ErrStr: 'File not found'),
  72.          (ErrCode: 3; ErrStr: 'Path not found'),
  73.          (ErrCode: 4; ErrStr: 'Too many open files'),
  74.          (ErrCode: 5; ErrStr: 'File access denied'),
  75.          (ErrCode: 6; ErrStr: 'Invalid file handle'),
  76.          (ErrCode: 12; ErrStr: 'Invalid file access code'),
  77.          (ErrCode: 15; ErrStr: 'Invalid drive number'),
  78.          (ErrCode: 16; ErrStr: 'Cannot remove current directory'),
  79.          (ErrCode: 17; ErrStr: 'Cannot rename across drives'),
  80.          (ErrCode: 33; ErrStr: 'Attempted to read locked disk'),
  81.          (ErrCode: 100; ErrStr: 'Disk read error'),
  82.          (ErrCode: 101; ErrStr: 'Disk write error'),
  83.          (ErrCode: 102; ErrStr: 'File not assigned'),
  84.          (ErrCode: 103; ErrStr: 'File not open'),
  85.          (ErrCode: 104; ErrStr: 'File not open for input'),
  86.          (ErrCode: 105; ErrStr: 'File not open for output'),
  87.          (ErrCode: 106; ErrStr: 'Invalid numeric format'),
  88.          (ErrCode: 150; ErrStr: 'Disk is write-protected'),
  89.          (ErrCode: 151; ErrStr: 'Bad drive request struct length'),
  90.          (ErrCode: 152; ErrStr: 'Drive not ready'),
  91.          (ErrCode: 154; ErrStr: 'CRC error in data'),
  92.          (ErrCode: 156; ErrStr: 'Disk seek error'),
  93.          (ErrCode: 157; ErrStr: 'Unknown media type'),
  94.          (ErrCode: 158; ErrStr: 'Sector Not Found'),
  95.          (ErrCode: 159; ErrStr: 'Printer out of paper'),
  96.          (ErrCode: 160; ErrStr: 'Device write fault'),
  97.          (ErrCode: 161; ErrStr: 'Device read fault'),
  98.          (ErrCode: 162; ErrStr: 'Hardware failure'),
  99.          (ErrCode: 200; ErrStr: 'Division by zero'),
  100.          (ErrCode: 201; ErrStr: 'Range check error'),
  101.          (ErrCode: 202; ErrStr: 'Stack overflow error'),
  102.          (ErrCode: 203; ErrStr: 'Heap overflow error'),
  103.          (ErrCode: 204; ErrStr: 'Invalid pointer operation'),
  104.          (ErrCode: 205; ErrStr: 'Floating point overflow'),
  105.          (ErrCode: 206; ErrStr: 'Floating point underflow'),
  106.          (ErrCode: 207; ErrStr: 'Invalid floating point operation'),
  107.          (ErrCode: 208; ErrStr: 'Overlay manager not installed'),
  108.          (ErrCode: 209; ErrStr: 'Overlay file read error'),
  109.          (ErrCode: 210; ErrStr: 'Object not initialized'),
  110.          (ErrCode: 211; ErrStr: 'Call to abstract method'),
  111.          (ErrCode: 212; ErrStr: 'Stream registration error'),
  112.          (ErrCode: 213; ErrStr: 'Collection index out of range'),
  113.          (ErrCode: 214; ErrStr: 'Collection overflow error'),
  114.          (ErrCode: 1001; ErrStr: 'dBase DBF file header invalid'),
  115.          (ErrCode: 1002; ErrStr: 'dBase record request beyond EOF'),
  116.          (ErrCode: 1003; ErrStr: 'dBase field name is invalid'),
  117.          (ErrCode: 1004; ErrStr: 'dBase field is of incorrect type'),
  118.          (ErrCode: 1005; ErrStr: 'dBase memo record has format error'),
  119.          (ErrCode: 1006; ErrStr: 'Formula expression cannot be translated'),
  120.          (ErrCode: 1112; ErrStr: 'Error in GSO_DiskFile.AddToFile'),
  121.          (ErrCode: 1103; ErrStr: 'Error in GSO_DiskFile.Close'),
  122.          (ErrCode: 1104; ErrStr: 'Error in GSO_DiskFile.Erase'),
  123.          (ErrCode: 1105; ErrStr: 'Error in GSO_DiskFile.FileSize'),
  124.          (ErrCode: 1111; ErrStr: 'Error in GSO_DiskFile.Flush'),
  125.          (ErrCode: 1101; ErrStr: 'Error in GSO_DiskFile.Read'),
  126.          (ErrCode: 1106; ErrStr: 'Error in GSO_DiskFile.ReName'),
  127.          (ErrCode: 1107; ErrStr: 'Error in GSO_DiskFile.Reset'),
  128.          (ErrCode: 1108; ErrStr: 'Error in GSO_DiskFile.Write'),
  129.          (ErrCode: 1109; ErrStr: 'Error in GSO_DiskFile.Truncate'),
  130.          (ErrCode: 1102; ErrStr: 'Error in GSO_DiskFile.Write'),
  131.          (ErrCode: 1206; ErrStr: 'Error in GSO_dBaseDBF.Append'),
  132.          (ErrCode: 1299; ErrStr: 'Error in GSO_dBaseFLD.CheckField'),
  133.          (ErrCode: 1207; ErrStr: 'Error in GSO_dBaseDBF.GetRec'),
  134.          (ErrCode: 1201; ErrStr: 'Error in GSO_dBaseDBF.HdrWrite'),
  135.          (ErrCode: 1204; ErrStr: 'Error in GSO_dBaseDBF.Init'),
  136.          (ErrCode: 1202; ErrStr: 'Error in GSO_dBaseDBF.PutRec'),
  137.          (ErrCode: 2101; ErrStr: 'Error in GSO_dBHandler.Formula'),
  138.          (ErrCode: 2102; ErrStr: 'Error in GSO_dBHandler.MemoGet'),
  139.          (ErrCode: 2103; ErrStr: 'Error in GSO_dBHandler.MemoGetN'),
  140.          (ErrCode: 2104; ErrStr: 'Error in GSO_dBHandler.MemoPutN'),
  141.          (ErrCode: 2105; ErrStr: 'Error in GSO_dBHandler.Pack'),
  142.          (ErrCode: 2106; ErrStr: 'Error in GSO_dBHandler.Zap'),
  143.          (ErrCode: 5101; ErrStr: 'Error in GSO_IndexFile.Init'),
  144.          (ErrCode: 5102; ErrStr: 'Error in GSO_IndexFile.Ndx_AdjVal'),
  145.          (ErrCode: 5211; ErrStr: 'Error in GSO_IdxColl.RetrieveKey'),
  146.          (ErrCode: 6101; ErrStr: 'Error in GSO_dBMemo.Init'),
  147.          (ErrCode: 6102; ErrStr: 'Error in GSO_dBMemo.MemoPut'),
  148.          (ErrCode: 6199; ErrStr: 'Error in GSO_dBMemo4.MemoSetParam'));
  149.  
  150. {-----------------------------------------------------------------------------}
  151. {$F+}
  152. Procedure UserCaptureError(Code, Info : integer);
  153. var
  154.    i  : integer;
  155.    ch : char;
  156. begin
  157.    writeln('Fatal Error Encountered in:');
  158.  
  159.    i := 0;
  160.    repeat
  161.       inc(i)
  162.    until (ErrListAry[i].ErrCode = Code) or (i > ErrCount);
  163.    if i <= ErrCount then
  164.       writeln('Code = ', Code:4,' ',ErrListAry[i].ErrStr)
  165.    else
  166.       writeln('Code = ', Code:4,' Unknown');
  167.  
  168.    i := 0;
  169.    repeat
  170.       inc(i)
  171.    until (ErrListAry[i].ErrCode = Info) or (i > ErrCount);
  172.    if i <= ErrCount then
  173.       writeln('Info = ', Info:4,' ',ErrListAry[i].ErrStr)
  174.    else
  175.       writeln('Info = ', Info:4,' Unknown');
  176.  
  177.    write('Press any key to continue');
  178.    ch := ReadKey;
  179.    writeln;
  180.    Halt;
  181. end;
  182. {$F-}
  183. {-----------------------------------------------------------------------------}
  184.  
  185.  
  186. {                              Main Program                                }
  187.  
  188. var
  189.    c : char;
  190.  
  191. begin
  192.                        {Create a file}
  193.    if not FileExist('GSDMO_18.DBF') then
  194.    begin
  195.       writeln('Creating GSDMO_18.DBF');
  196.       MakeTestData(3,'GSDMO_18', 20, false);
  197.       writeln('GSDMO_18.DBF Created');
  198.    end;
  199.  
  200.    ClrScr;
  201. {   SetExclusiveOn;}                   {Must be exclusive for Pack to work}
  202.    SetErrorCapture(UserCaptureError);
  203.    Select(1);
  204.    Use('GSDMO_xx');
  205.    Pack;
  206.    IndexOn('GSDMO_18','LASTNAME+FIRTNAME');
  207.    CloseDataBases;
  208.    write('Successful Completion!  Press any key to continue');
  209.    c := ReadKey;
  210.    writeln;
  211. end.
  212.  
  213. {---------------------------------------------------------------------------
  214.                                  ANSWERS
  215.  
  216.      1.  Should be   Use(GSDMO_18);
  217.      2.  Should be   IndexOn('GSDMO_18','LASTNAME+FIRSTNAME');
  218.      3.  Remove comments from SetExclusiveOn.  Have to have Exclusive
  219.          ownership of the file to allow Pack to work.  Multiuser file
  220.          sharing is the default and has to be reset before the file is
  221.          'Use'ed.
  222.  
  223.